home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
011
/
vidclock.arc
/
VIDCLOCK.BAS
Wrap
BASIC Source File
|
1985-08-04
|
8KB
|
248 lines
1 ' CLOCK.BAS - 5/3/82 - 5/8/82 - Digital Clock & Alarm.
2 ' by Wes Meier (70215,1017)
3 '
4 ' Requires BASICA and Color/Graphics Adapter
5 '
6 SCREEN 1,0:COLOR 1,0:KEY OFF:CLS:DEFINT A-Z:DEFSNG P,F
7 X=0:D0=0:D1=0:D2=0:D3=0:D4=0:D5=0:D6=0:D7=0:D8=0:D9=0:S36=3600:S10=10:S60=60
8 H1=0:H2=0:M1=0:M2=0:S1=0:S2=0:A=0:B=0:C=0:D=0:E=0:F=0:I=0
9 GOTO 45
10 '
11 ' Subroutine to put numbers on screen.
12 '
13 IF I=0 THEN I=10
14 ON I GOSUB 16,17,18,19,20,21,22,23,24,25
15 RETURN
16 PUT (X,40),D1,PSET:RETURN
17 PUT (X,40),D2,PSET:RETURN
18 PUT (X,40),D3,PSET:RETURN
19 PUT (X,40),D4,PSET:RETURN
20 PUT (X,40),D5,PSET:RETURN
21 PUT (X,40),D6,PSET:RETURN
22 PUT (X,40),D7,PSET:RETURN
23 PUT (X,40),D8,PSET:RETURN
24 PUT (X,40),D9,PSET:RETURN
25 PUT (X,40),D0,PSET:RETURN
26 '
27 '** Subroutine to Draw Clock Face **
28 '
29 CLS
30 LOCATE 3,15:PRINT "The Time is:"
31 LINE (0,30)-(319,109),2,B
32 LINE (4,34)-(315,105),2,B
33 PAINT (11,31),2,2
34 LINE(210,51)-(214,56),4,BF
35 LINE(210,85)-(214,90),4,BF
36 LINE(105,51)-(109,56),4,BF
37 LINE(105,85)-(109,90),4,BF
38 LOCATE 16,(40-LEN(DATEMESSAGE$))/2
39 PRINT DATEMESSAGE$
40 IF ALARM$<>"Y"THEN RETURN
41 LOCATE 21,9
42 PRINT"Alarm set at "ALARMTIME$"."
43 PRINT TAB(7)"Time remaining ="
44 RETURN
45 D=560:PI=3.14159
46 DIM D1(D),D2(D),D3(D),D4(D),D5(D),D6(D),D7(D),D8(D),D9(D),D0(D)
47 DIM MONTH$(12),DAY$(7)
48 'CREATE D1
49 LINE (29,40)-(33,99),,BF
50 LINE (20,95)-(41,99),,BF
51 PSET (29,40)
52 DRAW "G8F3E8"
53 PAINT (27,43)
54 GET (10,40)-(51,99),D1
55 CLS
56 'Create D2
57 CIRCLE (31,57),20,3
58 CIRCLE (31,57),15,3
59 CIRCLE (31,57),20,0,PI,1.8*PI
60 CIRCLE (31,57),15,0,PI,1.8*PI
61 LINE (10,57)-(15,57),3
62 PSET(10,95)
63 DRAW"D4R41U4L33"
64 LINE -(49,65)
65 LINE(44,65)-(10,95)
66 PAINT(30,42),3,3
67 LINE (47,91)-(51,99),3,BF
68 GET (10,40)-(51,99),D2
69 'Create D3
70 CLS
71 CIRCLE (31,82),20,3
72 CIRCLE (31,82),15,3
73 CIRCLE (31,82),20,0,PI/2,PI
74 CIRCLE (31,82),15,0,PI/2,PI
75 CIRCLE (31,55),18,3
76 CIRCLE (31,55),13,3
77 CIRCLE (31,55),18,0,PI,3*PI/2
78 CIRCLE (31,55),13,0,PI,3*PI/2
79 LINE (11,82)-(16,82),3
80 LINE (13,55)-(18,55),3
81 LINE (31,65)-(31,70)
82 PAINT (12,83),3,3
83 PAINT (14,54),3,3
84 PAINT (32,67),3,3
85 GET (10,40)-(51,99),D3
86 'CREATE D4
87 CLS
88 CIRCLE (10,40),28,3,3/2*PI,2*PI,2
89 CIRCLE (14,40),28,3,3/2*PI,2*PI,2
90 LINE (24,40)-(28,40)
91 PAINT (25,41),3,3
92 PSET (16,67)
93 LINE (10,73)-(51,69),3,BF
94 LINE (42,40)-(46,99),3,BF
95 LINE (51,99)-(37,95),3,BF
96 GET (10,40)-(51,99),D4
97 'CREATE D5
98 CLS
99 LINE (15,40)-(51,44),3,BF
100 LINE (10,69)-(30,65),3,BF
101 LINE (15,40)-(10,69)
102 LINE (19,40)-(14,69)
103 PAINT (16,45),3,3
104 LINE (51,40)-(47,49),3,BF
105 CIRCLE (31,82),20,3,PI,PI/2
106 CIRCLE (31,82),15,3,PI,PI/2
107 LINE (10,82)-(15,82)
108 PAINT (12,84),3,3
109 GET (10,40)-(51,99),D5
110 'CREATE D6
111 CLS
112 CIRCLE (31,82),20,3
113 CIRCLE (31,82),15,3
114 PAINT (12,84),3,3
115 CIRCLE (51,82),42,3,PI/2,PI,1.02
116 LINE (51,40)-(51,44),3
117 CIRCLE (51,82),37,3,PI/2,PI,1.02
118 PAINT (49,42),3,3
119 PSET (10,75):LINE (11,75)-(11,80),3,BF
120 GET (10,40)-(51,99),D6
121 'CREATE D7
122 CLS
123 LINE (10,40)-(14,49),3,BF
124 LINE (10,40)-(51,44),3,BF
125 LINE (29,99)-(33,99),3
126 CIRCLE (51,99),55,3,PI/2,PI,2.5
127 CIRCLE (55,103),55,3,PI/2,PI,2.5
128 LINE (51,40)-(51,49),3
129 PAINT (31,97),3,3
130 GET (10,40)-(51,99),D7
131 'CREATE D8
132 CLS
133 CIRCLE (31,82),20,3
134 CIRCLE (31,82),15,3
135 PAINT (12,84),3,3
136 CIRCLE (31,55),18,3
137 CIRCLE (31,55),13,3
138 PAINT (30,42),3,3
139 GET (10,40)-(51,99),D8
140 'CREATE D9
141 CLS
142 CIRCLE (31,57),20,3
143 CIRCLE (31,57),15,3
144 PAINT (30,42),3,3
145 CIRCLE (10,57),42,3,3*PI/2,2*PI,1.02
146 LINE (10,95)-(10,99),3
147 CIRCLE (10,57),37,3,3*PI/2,2*PI,1.02
148 PAINT (12,97),3,3
149 GET (10,40)-(51,99),D9
150 'CREATE D0
151 CLS
152 CIRCLE (30,71),28,3,PI,2*PI,59/42
153 CIRCLE (30,71),22,3,PI,2*PI,59/42
154 CIRCLE (30,68),28,3,0,PI,59/42
155 CIRCLE (30,68),22,3,0,PI,59/42
156 LINE(10,68)-(10,72)
157 LINE(14,68)-(14,72)
158 LINE(46,68)-(46,72)
159 LINE(50,68)-(50,72)
160 PAINT (12,70),3,3
161 GET (10,40)-(51,99),D0
162 CLS
163 LOCATE 12,1
164 PRINT "Have you set the date and time (Y/N) ?"
165 A$=INKEY$:IF A$="" THEN 165
166 IF A$=CHR$(13) OR A$="Y" OR A$="y" THEN 181
167 INPUT "Enter the TIME ";T$
168 ON ERROR GOTO 170
169 GOTO 171
170 RESUME 167
171 TIME$=T$
172 INPUT "Enter the DATE ";D$
173 ON ERROR GOTO 175
174 GOTO 176
175 RESUME 172
176 DATE$=D$
177 ON ERROR GOTO 0
178 DATA January,February,March,April,May,June,July,August,September,October
179 DATA November,December,Sunday,Monday,Tuesday,Wednesday,Thursday,Friday
180 DATA Saturday
181 RESTORE
182 FOR X=1 TO 12
183 READ MONTH$(X)
184 NEXT
185 FOR X=1 TO 7
186 READ DAY$(X)
187 NEXT
188 PRINT"Do you want to set an alarm (Y/N) ?"
189 A$=INKEY$:IF A$=""THEN 189
190 IF A$=CHR$(13) OR A$="Y" OR A$="y" THEN A$="Y" ELSE A$="N"
191 ALARM$=A$:IF A$="N"THEN 202
192 INPUT "Enter alarm time as HH:MM:SS ";ALARMTIME$
193 IF LEN(ALARMTIME$)<>8 THEN BEEP:GOTO 192
194 ALARMH=VAL (LEFT$(ALARMTIME$,2))
195 IF ALARMH<0 OR ALARMH>24 THEN BEEP:GOTO 192
196 ALARMS=VAL (RIGHT$(ALARMTIME$,2))
197 IF ALARMM<0 OR ALARMM>59 THEN BEEP:GOTO 192
198 ALARMM=VAL (MID$(ALARMTIME$,4,2))
199 IF ALARMS<0 OR ALARMS>59 THEN BEEP:GOTO 192
200 ALARMSEC!=S36*ALARMH+S60*ALARMM+ALARMS
201 MID$(ALARMTIME$,3,1)=":":MID$(ALARMTIME$,6,1)=":"
202 ' Set up day factor
203 MONTH=VAL(LEFT$(DATE$,2))
204 DAY=VAL(MID$(DATE$,4,2))
205 YEAR=VAL(RIGHT$(DATE$,4))
206 MONTH$=MONTH$(MONTH)
207 IF MONTH>2 THEN 209 ELSE F=365*YEAR+DAY+31*(MONTH-1)
208 F=F+(YEAR-1)\4-3*(((YEAR-1)\100+1))\4:GOTO 211
209 F=365*YEAR+DAY+31*(MONTH-1)
210 F=F-INT(.4*MONTH+2.3)+YEAR\4-3*(YEAR\100+1)\4
211 DAY$=DAY$(F+INT(-F/7+1)*7)
212 DATEMESSAGE$=DAY$+", "+MONTH$+STR$(DAY)+","+STR$(YEAR)
213 GOSUB 27
214 A=10:B=A:C=A:D=A:E=A:F=A
215 'Main Time comparison loop
216 H1=VAL (LEFT$(TIME$,1))
217 H2=VAL (MID$(TIME$,2,1))
218 M1=VAL (MID$(TIME$,4,1))
219 M2=VAL (MID$(TIME$,5,1))
220 S1=VAL (MID$(TIME$,7,1))
221 S2=VAL (RIGHT$(TIME$,1))
222 IF A<>S2 THEN A=S2:X=268:I=A:GOSUB 13
223 IF B<>S1 THEN B=S1:X=220:I=B:GOSUB 13
224 IF C<>M2 THEN C=M2:X=163:I=C:GOSUB 13
225 IF D<>M1 THEN D=M1:X=115:I=D:GOSUB 13
226 IF E<>H2 THEN E=H2:X=58:I=E:GOSUB 13
227 IF F<>H1 THEN F=H1:X=10:I=F:GOSUB 13
228 IF INKEY$<>""THEN 213
229 SECS!=S36*(S10*H1+H2)+S60*(S10*M1+M2)+S10*S1+S2:IF SECS!<5 THEN 202
230 IF ALARM$="N"THEN 216
231 SECSREM!=ALARMSEC!-SECS!
232 HRSREM=SECSREM!\S36:MINSREM=(SECSREM!-S36*HRSREM)\S60
233 SECSREM=SECSREM!-S36*HRSREM-S60*MINSREM
234 TIMEREM$=RIGHT$(STR$(HRSREM),2)+":"
235 TIMEREM$=TIMEREM$+RIGHT$(STR$(MINSREM),2)+":"+RIGHT$(STR$(SECSREM),2)
236 IF LEFT$(TIMEREM$,1)=" "THEN MID$(TIMEREM$,1)="0"
237 IF MID$(TIMEREM$,4,1)=" "THEN MID$(TIMEREM$,4,1)="0"
238 IF MID$(TIMEREM$,7,1)=" "THEN MID$(TIMEREM$,7,1)="0"
239 IF SECSREM!>0 THEN 243 ELSE TIMEREM$="00:00:00"
240 LOCATE 23,6:PRINT"Press Any Key to Stop Alarm.";
241 IF FLAG =0 THEN PLAY "MBL6G":FLAG=1:COLOR 2,1:GOTO 243
242 PLAY "MBL6C":FLAG=0:COLOR 1,0
243 LOCATE 22,24:PRINT TIMEREM$;
244 IF TIMEREM$<>"00:00:00" THEN 246
245 IF INKEY$<>"" THEN ALARM$="N":COLOR 1,0:GOTO 213
246 GOTO 216
247 END ' of program.
╚aÖn÷σ{l╖╧²/z≈ºv,aÖn÷σ}ñô~╪δ_Oz≈ºv,a1@Ö▀BΘ¥3τ╧÷"┴≤Ω∞▓¥+;$f₧\c⌠C-á:q╪-┬Æ┼Md ,≤<y╦¥q9uFû╢┴ö╕å¥q«σ|µτΓgß⌠=85>¼╘="≡